home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / dev / amos / ldosv25d.lha / ldos_demo / examples / ldos / Lfonts.AMOS / Lfonts.amosSourceCode
AMOS Source Code  |  1992-05-27  |  1KB  |  44 lines
  1. '
  2. ' Lfreq font and Ldisk font-demo 
  3. ' Bring up font-requester, mask out "/" and full pathname AFTER
  4. ' loading the font into memory (making it available to Get Rom Fonts)
  5. ' Then scan fonts i ROM to see if it loaded correctly and then set the 
  6. ' font and print a sample. 
  7. '
  8. Screen Open 1,640,256,8,Hires : Paper 0 : Clw 
  9. Centre "Select a font......" : Print 
  10. Wait 50
  11.  Extension_10_01EE "fonts:"
  12. Do 
  13.    Amos To Back 
  14.    ' Use $8 flag to bring up font-req.
  15.    A$= Extension_10_01A0("Select a nice font!",$4+$8+$10+$40+$100+$1000)
  16.    Amos To Front 
  17.    If A$="" Then Print "Aborted.." : End 
  18.    Print A$- Extension_10_0216 -"/";" is requsted..loading..."
  19.    Q= Extension_10_0326(A$, Extension_10_04DC )
  20.    Proc _FONTZ[A$, Extension_10_04DC ]
  21. Loop 
  22. Procedure _FONTZ[REQ$,SI]
  23.    REQ$=Upper$(REQ$- Extension_10_0216 )
  24.    REQ$=REQ$-"/" : Rem If user changed path...
  25.    Get Rom Fonts 
  26.    A=1
  27.    L=Len(REQ$)
  28.    While Font$(A)<>""
  29.       If Upper$(Mid$(Font$(A),1,L))=REQ$
  30.          If Val(Mid$(Font$(A),29,4))=SI
  31.             Set Font A
  32.             Exit 1
  33.          End If 
  34.       End If 
  35.       Inc A
  36.    Wend 
  37.    If Font$(A)<>""
  38.       Cls 0,0,100 To 640,256
  39.       Text 10,150,"Press a key or mouse"
  40.       Repeat 
  41.          Multi Wait 
  42.       Until(Mouse Click) or(Inkey$<>"")
  43.    End If 
  44. End Proc